home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / perl5 / perl5.002 / x2p / s2p.pl < prev    next >
Encoding:
Perl Script  |  1996-01-23  |  14.3 KB  |  783 lines
  1. #!/usr/local/bin/perl
  2.  
  3. use Config;
  4. use File::Basename qw(&basename &dirname);
  5.  
  6. # List explicitly here the variables you want Configure to
  7. # generate.  Metaconfig only looks for shell variables, so you
  8. # have to mention them as if they were shell variables, not
  9. # %Config entries.  Thus you write
  10. #  $startperl
  11. # to ensure Configure will look for $Config{startperl}.
  12.  
  13. # This forces PL files to create target in same directory as PL file.
  14. # This is so that make depend always knows where to find PL derivatives.
  15. chdir(dirname($0));
  16. ($file = basename($0)) =~ s/\.PL$//;
  17. $file =~ s/\.pl$//
  18.     if ($Config{'osname'} eq 'VMS' or
  19.         $Config{'osname'} eq 'OS2');  # "case-forgiving"
  20.  
  21. open OUT,">$file" or die "Can't create $file: $!";
  22.  
  23. print "Extracting $file (with variable substitutions)\n";
  24.  
  25. # In this section, perl variables will be expanded during extraction.
  26. # You can use $Config{...} to use Configure variables.
  27.  
  28. print OUT <<"!GROK!THIS!";
  29. $Config{'startperl'}
  30.     eval 'exec perl -S \$0 "\$@"'
  31.     if 0;
  32. \$startperl = "$Config{startperl}";
  33. !GROK!THIS!
  34.  
  35. # In the following, perl variables are not expanded during extraction.
  36.  
  37. print OUT <<'!NO!SUBS!';
  38.  
  39. # $RCSfile: s2p.SH,v $$Revision: 4.1 $$Date: 92/08/07 18:29:23 $
  40. #
  41. # $Log:    s2p.SH,v $
  42.  
  43. $indent = 4;
  44. $shiftwidth = 4;
  45. $l = '{'; $r = '}';
  46.  
  47. while ($ARGV[0] =~ /^-/) {
  48.     $_ = shift;
  49.   last if /^--/;
  50.     if (/^-D/) {
  51.     $debug++;
  52.     open(BODY,'>-');
  53.     next;
  54.     }
  55.     if (/^-n/) {
  56.     $assumen++;
  57.     next;
  58.     }
  59.     if (/^-p/) {
  60.     $assumep++;
  61.     next;
  62.     }
  63.     die "I don't recognize this switch: $_\n";
  64. }
  65.  
  66. unless ($debug) {
  67.     open(BODY,">/tmp/sperl$$") ||
  68.       &Die("Can't open temp file: $!\n");
  69. }
  70.  
  71. if (!$assumen && !$assumep) {
  72.     print BODY &q(<<'EOT');
  73. :    while ($ARGV[0] =~ /^-/) {
  74. :        $_ = shift;
  75. :      last if /^--/;
  76. :        if (/^-n/) {
  77. :        $nflag++;
  78. :        next;
  79. :        }
  80. :        die "I don't recognize this switch: $_\\n";
  81. :    }
  82. :    
  83. EOT
  84. }
  85.  
  86. print BODY &q(<<'EOT');
  87. :    #ifdef PRINTIT
  88. :    #ifdef ASSUMEP
  89. :    $printit++;
  90. :    #else
  91. :    $printit++ unless $nflag;
  92. :    #endif
  93. :    #endif
  94. :    <><>
  95. :    $\ = "\n";        # automatically add newline on print
  96. :    <><>
  97. :    #ifdef TOPLABEL
  98. :    LINE:
  99. :    while (chop($_ = <>)) {
  100. :    #else
  101. :    LINE:
  102. :    while (<>) {
  103. :        chop;
  104. :    #endif
  105. EOT
  106.  
  107. LINE:
  108. while (<>) {
  109.  
  110.     # Wipe out surrounding whitespace.
  111.  
  112.     s/[ \t]*(.*)\n$/$1/;
  113.  
  114.     # Perhaps it's a label/comment.
  115.  
  116.     if (/^:/) {
  117.     s/^:[ \t]*//;
  118.     $label = &make_label($_);
  119.     if ($. == 1) {
  120.         $toplabel = $label;
  121.         if (/^(top|(re)?start|redo|begin(ning)|again|input)$/i) {
  122.         $_ = <>;
  123.         redo LINE; # Never referenced, so delete it if not a comment.
  124.         }
  125.     }
  126.     $_ = "$label:";
  127.     if ($lastlinewaslabel++) {
  128.         $indent += 4;
  129.         print BODY &tab, ";\n";
  130.         $indent -= 4;
  131.     }
  132.     if ($indent >= 2) {
  133.         $indent -= 2;
  134.         $indmod = 2;
  135.     }
  136.     next;
  137.     } else {
  138.     $lastlinewaslabel = '';
  139.     }
  140.  
  141.     # Look for one or two address clauses
  142.  
  143.     $addr1 = '';
  144.     $addr2 = '';
  145.     if (s/^([0-9]+)//) {
  146.     $addr1 = "$1";
  147.     $addr1 = "\$. == $addr1" unless /^,/;
  148.     }
  149.     elsif (s/^\$//) {
  150.     $addr1 = 'eof()';
  151.     }
  152.     elsif (s|^/||) {
  153.     $addr1 = &fetchpat('/');
  154.     }
  155.     if (s/^,//) {
  156.     if (s/^([0-9]+)//) {
  157.         $addr2 = "$1";
  158.     } elsif (s/^\$//) {
  159.         $addr2 = "eof()";
  160.     } elsif (s|^/||) {
  161.         $addr2 = &fetchpat('/');
  162.     } else {
  163.         &Die("Invalid second address at line $.\n");
  164.     }
  165.     if ($addr2 =~ /^\d+$/) {
  166.         $addr1 .= "..$addr2";
  167.     }
  168.     else {
  169.         $addr1 .= "...$addr2";
  170.     }
  171.     }
  172.  
  173.     # Now we check for metacommands {, }, and ! and worry
  174.     # about indentation.
  175.  
  176.     s/^[ \t]+//;
  177.     # a { to keep vi happy
  178.     if ($_ eq '}') {
  179.     $indent -= 4;
  180.     next;
  181.     }
  182.     if (s/^!//) {
  183.     $if = 'unless';
  184.     $else = "$r else $l\n";
  185.     } else {
  186.     $if = 'if';
  187.     $else = '';
  188.     }
  189.     if (s/^{//) {    # a } to keep vi happy
  190.     $indmod = 4;
  191.     $redo = $_;
  192.     $_ = '';
  193.     $rmaybe = '';
  194.     } else {
  195.     $rmaybe = "\n$r";
  196.     if ($addr2 || $addr1) {
  197.         $space = ' ' x $shiftwidth;
  198.     } else {
  199.         $space = '';
  200.     }
  201.     $_ = &transmogrify();
  202.     }
  203.  
  204.     # See if we can optimize to modifier form.
  205.  
  206.     if ($addr1) {
  207.     if ($_ !~ /[\n{}]/ && $rmaybe && !$change &&
  208.       $_ !~ / if / && $_ !~ / unless /) {
  209.         s/;$/ $if $addr1;/;
  210.         $_ = substr($_,$shiftwidth,1000);
  211.     } else {
  212.         $_ = "$if ($addr1) $l\n$change$_$rmaybe";
  213.     }
  214.     $change = '';
  215.     next LINE;
  216.     }
  217. } continue {
  218.     @lines = split(/\n/,$_);
  219.     for (@lines) {
  220.     unless (s/^ *<<--//) {
  221.         print BODY &tab;
  222.     }
  223.     print BODY $_, "\n";
  224.     }
  225.     $indent += $indmod;
  226.     $indmod = 0;
  227.     if ($redo) {
  228.     $_ = $redo;
  229.     $redo = '';
  230.     redo LINE;
  231.     }
  232. }
  233. if ($lastlinewaslabel++) {
  234.     $indent += 4;
  235.     print BODY &tab, ";\n";
  236.     $indent -= 4;
  237. }
  238.  
  239. if ($appendseen || $tseen || !$assumen) {
  240.     $printit++ if $dseen || (!$assumen && !$assumep);
  241.     print BODY &q(<<'EOT');
  242. :    #ifdef SAWNEXT
  243. :    }
  244. :    continue {
  245. :    #endif
  246. :    #ifdef PRINTIT
  247. :    #ifdef DSEEN
  248. :    #ifdef ASSUMEP
  249. :        print if $printit++;
  250. :    #else
  251. :        if ($printit)
  252. :        { print; }
  253. :        else
  254. :        { $printit++ unless $nflag; }
  255. :    #endif
  256. :    #else
  257. :        print if $printit;
  258. :    #endif
  259. :    #else
  260. :        print;
  261. :    #endif
  262. :    #ifdef TSEEN
  263. :        $tflag = 0;
  264. :    #endif
  265. :    #ifdef APPENDSEEN
  266. :        if ($atext) { chop $atext; print $atext; $atext = ''; }
  267. :    #endif
  268. EOT
  269.  
  270. print BODY &q(<<'EOT');
  271. :    }
  272. EOT
  273. }
  274.  
  275. close BODY;
  276.  
  277. unless ($debug) {
  278.     open(HEAD,">/tmp/sperl2$$.c")
  279.       || &Die("Can't open temp file 2: $!\n");
  280.     print HEAD "#define PRINTIT\n"    if $printit;
  281.     print HEAD "#define APPENDSEEN\n"    if $appendseen;
  282.     print HEAD "#define TSEEN\n"    if $tseen;
  283.     print HEAD "#define DSEEN\n"    if $dseen;
  284.     print HEAD "#define ASSUMEN\n"    if $assumen;
  285.     print HEAD "#define ASSUMEP\n"    if $assumep;
  286.     print HEAD "#define TOPLABEL\n"    if $toplabel;
  287.     print HEAD "#define SAWNEXT\n"    if $sawnext;
  288.     if ($opens) {print HEAD "$opens\n";}
  289.     open(BODY,"/tmp/sperl$$")
  290.       || &Die("Can't reopen temp file: $!\n");
  291.     while (<BODY>) {
  292.     print HEAD $_;
  293.     }
  294.     close HEAD;
  295.  
  296.     print &q(<<"EOT");
  297. :    $startperl
  298. :    eval 'exec perl -S \$0 \${1+"\$@"}'
  299. :        if \$running_under_some_shell;
  300. :    
  301. EOT
  302.     open(BODY,"cc -E /tmp/sperl2$$.c |") ||
  303.     &Die("Can't reopen temp file: $!\n");
  304.     while (<BODY>) {
  305.     /^# [0-9]/ && next;
  306.     /^[ \t]*$/ && next;
  307.     s/^<><>//;
  308.     print;
  309.     }
  310. }
  311.  
  312. &Cleanup;
  313. exit;
  314.  
  315. sub Cleanup {
  316.     chdir "/tmp";
  317.     unlink "sperl$$", "sperl2$$", "sperl2$$.c";
  318. }
  319. sub Die {
  320.     &Cleanup;
  321.     die $_[0];
  322. }
  323. sub tab {
  324.     "\t" x ($indent / 8) . ' ' x ($indent % 8);
  325. }
  326. sub make_filehandle {
  327.     local($_) = $_[0];
  328.     local($fname) = $_;
  329.     if (!$seen{$fname}) {
  330.     $_ = "FH_" . $_ if /^\d/;
  331.     s/[^a-zA-Z0-9]/_/g;
  332.     s/^_*//;
  333.     $_ = "\U$_";
  334.     if ($fhseen{$_}) {
  335.         for ($tmp = "a"; $fhseen{"$_$tmp"}; $a++) {}
  336.         $_ .= $tmp;
  337.     }
  338.     $fhseen{$_} = 1;
  339.     $opens .= &q(<<"EOT");
  340. :    open($_, '>$fname') || die "Can't create $fname: \$!";
  341. EOT
  342.     $seen{$fname} = $_;
  343.     }
  344.     $seen{$fname};
  345. }
  346.  
  347. sub make_label {
  348.     local($label) = @_;
  349.     $label =~ s/[^a-zA-Z0-9]/_/g;
  350.     if ($label =~ /^[0-9_]/) { $label = 'L' . $label; }
  351.     $label = substr($label,0,8);
  352.  
  353.     # Could be a reserved word, so capitalize it.
  354.     substr($label,0,1) =~ y/a-z/A-Z/
  355.       if $label =~ /^[a-z]/;
  356.  
  357.     $label;
  358. }
  359.  
  360. sub transmogrify {
  361.     {    # case
  362.     if (/^d/) {
  363.         $dseen++;
  364.         chop($_ = &q(<<'EOT'));
  365. :    <<--#ifdef PRINTIT
  366. :    $printit = 0;
  367. :    <<--#endif
  368. :    next LINE;
  369. EOT
  370.         $sawnext++;
  371.         next;
  372.     }
  373.  
  374.     if (/^n/) {
  375.         chop($_ = &q(<<'EOT'));
  376. :    <<--#ifdef PRINTIT
  377. :    <<--#ifdef DSEEN
  378. :    <<--#ifdef ASSUMEP
  379. :    print if $printit++;
  380. :    <<--#else
  381. :    if ($printit)
  382. :        { print; }
  383. :    else
  384. :        { $printit++ unless $nflag; }
  385. :    <<--#endif
  386. :    <<--#else
  387. :    print if $printit;
  388. :    <<--#endif
  389. :    <<--#else
  390. :    print;
  391. :    <<--#endif
  392. :    <<--#ifdef APPENDSEEN
  393. :    if ($atext) {chop $atext; print $atext; $atext = '';}
  394. :    <<--#endif
  395. :    $_ = <>;
  396. :    chop;
  397. :    <<--#ifdef TSEEN
  398. :    $tflag = 0;
  399. :    <<--#endif
  400. EOT
  401.         next;
  402.     }
  403.  
  404.     if (/^a/) {
  405.         $appendseen++;
  406.         $command = $space . "\$atext .= <<'End_Of_Text';\n<<--";
  407.         $lastline = 0;
  408.         while (<>) {
  409.         s/^[ \t]*//;
  410.         s/^[\\]//;
  411.         unless (s|\\$||) { $lastline = 1;}
  412.         s/^([ \t]*\n)/<><>$1/;
  413.         $command .= $_;
  414.         $command .= '<<--';
  415.         last if $lastline;
  416.         }
  417.         $_ = $command . "End_Of_Text";
  418.         last;
  419.     }
  420.  
  421.     if (/^[ic]/) {
  422.         if (/^c/) { $change = 1; }
  423.         $addr1 = 1 if $addr1 eq '';
  424.         $addr1 = '$iter = (' . $addr1 . ')';
  425.         $command = $space .
  426.           "    if (\$iter == 1) { print <<'End_Of_Text'; }\n<<--";
  427.         $lastline = 0;
  428.         while (<>) {
  429.         s/^[ \t]*//;
  430.         s/^[\\]//;
  431.         unless (s/\\$//) { $lastline = 1;}
  432.         s/'/\\'/g;
  433.         s/^([ \t]*\n)/<><>$1/;
  434.         $command .= $_;
  435.         $command .= '<<--';
  436.         last if $lastline;
  437.         }
  438.         $_ = $command . "End_Of_Text";
  439.         if ($change) {
  440.         $dseen++;
  441.         $change = "$_\n";
  442.         chop($_ = &q(<<"EOT"));
  443. :    <<--#ifdef PRINTIT
  444. :    $space\$printit = 0;
  445. :    <<--#endif
  446. :    ${space}next LINE;
  447. EOT
  448.         $sawnext++;
  449.         }
  450.         last;
  451.     }
  452.  
  453.     if (/^s/) {
  454.         $delim = substr($_,1,1);
  455.         $len = length($_);
  456.         $repl = $end = 0;
  457.         $inbracket = 0;
  458.         for ($i = 2; $i < $len; $i++) {
  459.         $c = substr($_,$i,1);
  460.         if ($c eq $delim) {
  461.             if ($inbracket) {
  462.             substr($_, $i, 0) = '\\';
  463.             $i++;
  464.             $len++;
  465.             }
  466.             else {
  467.             if ($repl) {
  468.                 $end = $i;
  469.                 last;
  470.             } else {
  471.                 $repl = $i;
  472.             }
  473.             }
  474.         }
  475.         elsif ($c eq '\\') {
  476.             $i++;
  477.             if ($i >= $len) {
  478.             $_ .= 'n';
  479.             $_ .= <>;
  480.             $len = length($_);
  481.             $_ = substr($_,0,--$len);
  482.             }
  483.             elsif (substr($_,$i,1) =~ /^[n]$/) {
  484.             ;
  485.             }
  486.             elsif (!$repl &&
  487.               substr($_,$i,1) =~ /^[(){}\w]$/) {
  488.             $i--;
  489.             $len--;
  490.             substr($_, $i, 1) = '';
  491.             }
  492.             elsif (!$repl &&
  493.               substr($_,$i,1) =~ /^[<>]$/) {
  494.             substr($_,$i,1) = 'b';
  495.             }
  496.             elsif ($repl && substr($_,$i,1) =~ /^\d$/) {
  497.             substr($_,$i-1,1) = '$';
  498.             }
  499.         }
  500.         elsif ($c eq '&' && $repl) {
  501.             substr($_, $i, 0) = '$';
  502.             $i++;
  503.             $len++;
  504.         }
  505.         elsif ($c eq '$' && $repl) {
  506.             substr($_, $i, 0) = '\\';
  507.             $i++;
  508.             $len++;
  509.         }
  510.         elsif ($c eq '[' && !$repl) {
  511.             $i++ if substr($_,$i,1) eq '^';
  512.             $i++ if substr($_,$i,1) eq ']';
  513.             $inbracket = 1;
  514.         }
  515.         elsif ($c eq ']') {
  516.             $inbracket = 0;
  517.         }
  518.         elsif ($c eq "\t") {
  519.             substr($_, $i, 1) = '\\t';
  520.             $i++;
  521.             $len++;
  522.         }
  523.         elsif (!$repl && index("()+",$c) >= 0) {
  524.             substr($_, $i, 0) = '\\';
  525.             $i++;
  526.             $len++;
  527.         }
  528.         }
  529.         &Die("Malformed substitution at line $.\n")
  530.           unless $end;
  531.         $pat = substr($_, 0, $repl + 1);
  532.         $repl = substr($_, $repl+1, $end-$repl-1);
  533.         $end = substr($_, $end + 1, 1000);
  534.         &simplify($pat);
  535.         $dol = '$';
  536.         $subst = "$pat$repl$delim";
  537.         $cmd = '';
  538.         while ($end) {
  539.         if ($end =~ s/^g//) {
  540.             $subst .= 'g';
  541.             next;
  542.         }
  543.         if ($end =~ s/^p//) {
  544.             $cmd .= ' && (print)';
  545.             next;
  546.         }
  547.         if ($end =~ s/^w[ \t]*//) {
  548.             $fh = &make_filehandle($end);
  549.             $cmd .= " && (print $fh \$_)";
  550.             $end = '';
  551.             next;
  552.         }
  553.         &Die("Unrecognized substitution command".
  554.           "($end) at line $.\n");
  555.         }
  556.         chop ($_ = &q(<<"EOT"));
  557. :    <<--#ifdef TSEEN
  558. :    $subst && \$tflag++$cmd;
  559. :    <<--#else
  560. :    $subst$cmd;
  561. :    <<--#endif
  562. EOT
  563.         next;
  564.     }
  565.  
  566.     if (/^p/) {
  567.         $_ = 'print;';
  568.         next;
  569.     }
  570.  
  571.     if (/^w/) {
  572.         s/^w[ \t]*//;
  573.         $fh = &make_filehandle($_);
  574.         $_ = "print $fh \$_;";
  575.         next;
  576.     }
  577.  
  578.     if (/^r/) {
  579.         $appendseen++;
  580.         s/^r[ \t]*//;
  581.         $file = $_;
  582.         $_ = "\$atext .= `cat $file 2>/dev/null`;";
  583.         next;
  584.     }
  585.  
  586.     if (/^P/) {
  587.         $_ = 'print $1 if /^(.*)/;';
  588.         next;
  589.     }
  590.  
  591.     if (/^D/) {
  592.         chop($_ = &q(<<'EOT'));
  593. :    s/^.*\n?//;
  594. :    redo LINE if $_;
  595. :    next LINE;
  596. EOT
  597.         $sawnext++;
  598.         next;
  599.     }
  600.  
  601.     if (/^N/) {
  602.         chop($_ = &q(<<'EOT'));
  603. :    $_ .= "\n";
  604. :    $len1 = length;
  605. :    $_ .= <>;
  606. :    chop if $len1 < length;
  607. :    <<--#ifdef TSEEN
  608. :    $tflag = 0;
  609. :    <<--#endif
  610. EOT
  611.         next;
  612.     }
  613.  
  614.     if (/^h/) {
  615.         $_ = '$hold = $_;';
  616.         next;
  617.     }
  618.  
  619.     if (/^H/) {
  620.         $_ = '$hold .= "\n"; $hold .= $_;';
  621.         next;
  622.     }
  623.  
  624.     if (/^g/) {
  625.         $_ = '$_ = $hold;';
  626.         next;
  627.     }
  628.  
  629.     if (/^G/) {
  630.         $_ = '$_ .= "\n"; $_ .= $hold;';
  631.         next;
  632.     }
  633.  
  634.     if (/^x/) {
  635.         $_ = '($_, $hold) = ($hold, $_);';
  636.         next;
  637.     }
  638.  
  639.     if (/^b$/) {
  640.         $_ = 'next LINE;';
  641.         $sawnext++;
  642.         next;
  643.     }
  644.  
  645.     if (/^b/) {
  646.         s/^b[ \t]*//;
  647.         $lab = &make_label($_);
  648.         if ($lab eq $toplabel) {
  649.         $_ = 'redo LINE;';
  650.         } else {
  651.         $_ = "goto $lab;";
  652.         }
  653.         next;
  654.     }
  655.  
  656.     if (/^t$/) {
  657.         $_ = 'next LINE if $tflag;';
  658.         $sawnext++;
  659.         $tseen++;
  660.         next;
  661.     }
  662.  
  663.     if (/^t/) {
  664.         s/^t[ \t]*//;
  665.         $lab = &make_label($_);
  666.         $_ = q/if ($tflag) {$tflag = 0; /;
  667.         if ($lab eq $toplabel) {
  668.         $_ .= 'redo LINE;}';
  669.         } else {
  670.         $_ .= "goto $lab;}";
  671.         }
  672.         $tseen++;
  673.         next;
  674.     }
  675.  
  676.     if (/^y/) {
  677.         s/abcdefghijklmnopqrstuvwxyz/a-z/g;
  678.         s/ABCDEFGHIJKLMNOPQRSTUVWXYZ/A-Z/g;
  679.         s/abcdef/a-f/g;
  680.         s/ABCDEF/A-F/g;
  681.         s/0123456789/0-9/g;
  682.         s/01234567/0-7/g;
  683.         $_ .= ';';
  684.     }
  685.  
  686.     if (/^=/) {
  687.         $_ = 'print $.;';
  688.         next;
  689.     }
  690.  
  691.     if (/^q/) {
  692.         chop($_ = &q(<<'EOT'));
  693. :    close(ARGV);
  694. :    @ARGV = ();
  695. :    next LINE;
  696. EOT
  697.         $sawnext++;
  698.         next;
  699.     }
  700.     } continue {
  701.     if ($space) {
  702.         s/^/$space/;
  703.         s/(\n)(.)/$1$space$2/g;
  704.     }
  705.     last;
  706.     }
  707.     $_;
  708. }
  709.  
  710. sub fetchpat {
  711.     local($outer) = @_;
  712.     local($addr) = $outer;
  713.     local($inbracket);
  714.     local($prefix,$delim,$ch);
  715.  
  716.     # Process pattern one potential delimiter at a time.
  717.  
  718.     DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) {
  719.     $prefix = $1;
  720.     $delim = $2;
  721.     if ($delim eq '\\') {
  722.         s/(.)//;
  723.         $ch = $1;
  724.         $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/;
  725.         $ch = 'b' if $ch =~ /^[<>]$/;
  726.         $delim .= $ch;
  727.     }
  728.     elsif ($delim eq '[') {
  729.         $inbracket = 1;
  730.         s/^\^// && ($delim .= '^');
  731.         s/^]// && ($delim .= ']');
  732.     }
  733.     elsif ($delim eq ']') {
  734.         $inbracket = 0;
  735.     }
  736.     elsif ($inbracket || $delim ne $outer) {
  737.         $delim = '\\' . $delim;
  738.     }
  739.     $addr .= $prefix;
  740.     $addr .= $delim;
  741.     if ($delim eq $outer && !$inbracket) {
  742.         last DELIM;
  743.     }
  744.     }
  745.     $addr =~ s/\t/\\t/g;
  746.     &simplify($addr);
  747.     $addr;
  748. }
  749.  
  750. sub q {
  751.     local($string) = @_;
  752.     local($*) = 1;
  753.     $string =~ s/^:\t?//g;
  754.     $string;
  755. }
  756.  
  757. sub simplify {
  758.     $_[0] =~ s/_a-za-z0-9/\\w/ig;
  759.     $_[0] =~ s/a-z_a-z0-9/\\w/ig;
  760.     $_[0] =~ s/a-za-z_0-9/\\w/ig;
  761.     $_[0] =~ s/a-za-z0-9_/\\w/ig;
  762.     $_[0] =~ s/_0-9a-za-z/\\w/ig;
  763.     $_[0] =~ s/0-9_a-za-z/\\w/ig;
  764.     $_[0] =~ s/0-9a-z_a-z/\\w/ig;
  765.     $_[0] =~ s/0-9a-za-z_/\\w/ig;
  766.     $_[0] =~ s/\[\\w\]/\\w/g;
  767.     $_[0] =~ s/\[^\\w\]/\\W/g;
  768.     $_[0] =~ s/\[0-9\]/\\d/g;
  769.     $_[0] =~ s/\[^0-9\]/\\D/g;
  770.     $_[0] =~ s/\\d\\d\*/\\d+/g;
  771.     $_[0] =~ s/\\D\\D\*/\\D+/g;
  772.     $_[0] =~ s/\\w\\w\*/\\w+/g;
  773.     $_[0] =~ s/\\t\\t\*/\\t+/g;
  774.     $_[0] =~ s/(\[.[^]]*\])\1\*/$1+/g;
  775.     $_[0] =~ s/([\w\s!@#%^&-=,:;'"])\1\*/$1+/g;
  776. }
  777.  
  778. !NO!SUBS!
  779.  
  780. close OUT or die "Can't close $file: $!";
  781. chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
  782. exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
  783.